CU Amiga Super CD-ROM 18/CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso/CUCD/Utilities/Fiasco/Databases/PictureDatabase/AddPicture.frx

Text File | 1997-10-06 | 4.1 KB | 214 lines

/* addpicture.frx
 * Adds a new picture entry to Fiasco's picture database
 * Copyright © 1996-1997 Nils Bandener
 * $VER: addpicture_frx 6.4 (6.10.97)
 */

Options Results
Options Failat 21
Parse Arg FileName

scriptname = "AddPicture"

fiasco_port = address()

Signal on Syntax
Signal on Halt
Signal on Break_C
Signal on Failure

LockGUI

/*
 * Constant values
 */

DTFieldsInRecord = 8

if FileName = "" then
do
    /*
     * if no name is given, request
     * the name
     */

    RequestFile 'Title "Select picture" Noicons ProjectRelative Var Filename'
end

if FileName ~= "" then do

    CountRecords var numrecs

    /*
     * Initialize these vars to
     * remember the field and
     * record number
     */

    fieldnumber = 0
    recordnumber = 0

    if numrecs > 0 then
    do
        do i = 1 to numrecs

            GetField "Cnt" Record i
            cnt = result

            if result ~= DTFieldsInRecord then
            do

                k = 1

                do while k <= DTFieldsInRecord & fieldnumber = 0

                    GetField "Name_" || k Record i

                    if result = "" then do

                        fieldnumber = k
                        recordnumber = i

                    end

                    k = k + 1
                end
            end
        end
    end

    if recordnumber = 0 | fieldnumber = 0 then
    do
        /*
         * No record had a free field.
         * Create a new record
         */

        AddRecord record numrecs

        numrecs = numrecs + 1

        recordnumber = numrecs

        fieldnumber = 1

        cnt = 0
    end

    GetField "Key" record recordnumber
    Key = Result

    tnname = 'TN/TN_' || Key || '_' || Cnt

    /*
     *  "__in_archive__" is a magic path component used
     *  by ScanDir.rexx to seperate the dos path and the path
     *  in an archive.
     */

    archive = pos("/__in_archive__/", FileName)

    if archive ~= 0 then
    do
        ArcName = left(FileName, archive - 1)
        NameInArc = substr(FileName, archive + 16)

        Address Command 'lha >nil: <nil: x "' || ArcName || '" "' || NameInArc || '" t:'

        if rc = 0 then
        do
            ExtractedName = "t:" || NameInArc
            Address Command 'createthumbnail "' || ExtractedName || '" "' || tnname || '"'
        end

        oldrc = rc  /* Preserve rc */
        Address Command 'delete >nil: "' || ExtractedName || '" quiet'

        if pos("/", NameInArc) ~= 0 then
        do
            Address Command 'delete >nil: "t:' || substr(NameInArc, pos("/", NameInArc) - 1) || '" all'
        end

        rc = oldrc
    end
    else
    do
        Address Command 'createthumbnail "' || FileName || '" "' || tnname || '"'
    end

    if rc = 0 then
    do
        SetField "Name_" || fieldnumber Record recordnumber FileName

        SetField "DT_" || fieldnumber record recordnumber '"' || tnname || '"'

        cnt = cnt + 1

        SetField "Cnt" Record recordnumber cnt

        width = -1
        height = -1
        depth = -1
        colors = -1

        if Open("f", "t:thumbnaildata", "read") then
        do
            l = ReadLn("f")

            parse var l "Width" width "Height" height "Depth" depth "Colors" colors

            call Close("f")
        end

        SetField "Width_" || fieldnumber Record recordnumber width
        SetField "Height_" || fieldnumber Record recordnumber height
        SetField "Colors_" || fieldnumber Record recordnumber colors
    end
end

bail_out:

Address Value fiasco_port

UnlockGUI
ResetStatus

exit

syntax:
failure:

if show("Ports", fiasco_port) then
do
    Address Value fiasco_port

    RequestChoice '"Error ' || rc || ' in line ' || sigl || ':*n' || errortext(rc) || '" "Cancel" Title "' || scriptname || '"'
end
else
do
    say "Error" rc "in line" sigl ":" errortext(rc)
    say "Enter to continue"
    pull dummy
end

call bail_out

halt:
break_c:

if show("Ports", fiasco_port) then
do
    Address Value fiasco_port

    RequestChoice '"Script Abort Requested" "Abort Script" Title "' || scriptname || '"'
end
else
do
    say "*** Break"
    say "Enter to continue"
    pull dummy
end

call bail_out